home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 23 / CU Amiga - Super CD-ROM 23 (June 1998).iso / CreatingGames / Utilities / Misc / GMS / GMSDev / Source / E / Demos / Kohonen.e < prev    next >
Encoding:
Text File  |  1997-12-23  |  4.5 KB  |  166 lines
  1. /* Kohonen Feature Maps in E, implemented with integers
  2. **
  3. ** Kohonen feature maps are special types of neural nets, and
  4. ** this implementation shows graphically how they organise themselves
  5. ** after a while.
  6. **
  7. ** [This demo from the AmigaE archives has been converted to work with GMS.
  8. ** It is at about 33% faster than the original intuition version.]
  9. */
  10.  
  11. CONST ONE     = 1024*16,   KSHIFT = 14,      KSIZE  = 7,
  12.       MAXTIME = 500,       DELAY  = 0,       YOFF   = 20
  13. CONST KSTEP   = ONE/KSIZE, KNODES = KSIZE+1, ARSIZE = KSIZE*KSIZE,
  14.       XRED    = 64,        YRED   = 128,     XOFF   = 10
  15.  
  16. MODULE 'dpkernel','dpkernel/dpkernel','graphics/pictures','files/files'
  17. MODULE 'screens','system/register','system/modules','input/joydata'
  18. MODULE 'graphics/screens','blitter','graphics/blitter'
  19.  
  20. /*=========================================================================*/
  21.  
  22. PROC main()
  23.  DEF screen    = NIL:PTR TO screen,
  24.      scrmodule = NIL:PTR TO module,
  25.      bltmodule = NIL:PTR TO module,
  26.      map, t, input, x, y
  27.  
  28.  IF dpkbase := OpenLibrary('GMS:libs/dpkernel.library',0)
  29.   IF (scrmodule := Init([TAGS_MODULE,NIL,
  30.       MODA_NUMBER,    MOD_SCREENS,
  31.       MODA_TABLETYPE, JMP_AMIGAE,
  32.       TAGEND], NIL))
  33.       scrbase := scrmodule.modbase
  34.  
  35.   IF (bltmodule := Init([TAGS_MODULE,NIL,
  36.       MODA_NUMBER,    MOD_BLITTER,
  37.       MODA_TABLETYPE, JMP_AMIGAE,
  38.       TAGEND], NIL))
  39.       bltbase := bltmodule.modbase
  40.  
  41.     IF (screen := Init([TAGS_SCREEN,NIL,
  42.        GSA_Attrib,    DBLBUFFER OR CENTRE,
  43.        GSA_ScrMode,   HIRES,
  44.        GSA_Width,     320,
  45.        GSA_Height,    256,
  46.        GSA_Palette,   [ NIL, NIL, $000000, $f0f0f0 ],
  47.          GSA_BitmapTags, NIL,
  48.          BMA_Planes,     2,
  49.          TAGEND,         NIL,
  50.        TAGEND],NIL))
  51.  
  52.         Display(screen)
  53.  
  54.         map := kohonen_init(KSIZE,KSIZE,2)
  55.  
  56.         FOR t := 0 TO MAXTIME-1
  57.           input := [Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  58.           x,y   := kohonen_BMU(map,input)
  59.           kohonen_plot(map,screen,x,y)
  60.           kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  61.         ENDFOR
  62.  
  63.         WaitTime(100)
  64.  
  65.     Free(screen)
  66.     ENDIF
  67.    Free(bltmodule)
  68.    ENDIF
  69.   Free(scrmodule)
  70.   ENDIF
  71.  CloseDPK()
  72.  ENDIF
  73. ENDPROC
  74.  
  75. /*=========================================================================*/
  76.  
  77. PROC kohonen_plot(map,screen:PTR TO screen,bx,by)
  78. DEF x,y,n:PTR TO LONG,cx,cy,i,ii,sx[ARSIZE]:ARRAY OF LONG
  79. DEF sy[ARSIZE]:ARRAY OF LONG
  80.  
  81.   ClearBitmap(screen.bitmap)
  82.   FOR x:=0 TO KSIZE-1
  83.     FOR y:=0 TO KSIZE-1
  84.       n := kohonen_node(map,x,y)
  85.       i := x*KSIZE+y
  86.       ii := x-1*KSIZE+y
  87.       sx[i] := cx := s(n[0]/XRED+XOFF)
  88.       sy[i] := cy := s(n[1]/YRED+YOFF)
  89.       IF x>0 THEN DrawLine(screen.bitmap,sx[ii],sy[ii],cx,cy,1)
  90.       IF y>0 THEN DrawLine(screen.bitmap,sx[i-1],sy[i-1],cx,cy,1)
  91.     ENDFOR
  92.   ENDFOR
  93.  
  94.   n := kohonen_node(map,bx,by)
  95.   DrawPixel(screen.bitmap,s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),1)
  96.   WaitAVBL()
  97.   SwapBuffers(screen)
  98.   screen.bitmap.data := screen.memptr2
  99. ENDPROC
  100.  
  101. /*=========================================================================*/
  102.  
  103. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  104.  
  105. /*=========================================================================*/
  106.  
  107. PROC kohonen_BMU(map,i:PTR TO LONG)
  108.   DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  109.  
  110.   len:=ListLen(i)-1
  111.   FOR x:=0 TO KSIZE-1
  112.     FOR y:=0 TO KSIZE-1
  113.       n:=kohonen_node(map,x,y)
  114.       act:=0
  115.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  116.       IF act<bestact
  117.          bestx := x
  118.          besty := y
  119.          bestact := act
  120.       ENDIF
  121.     ENDFOR
  122.   ENDFOR
  123.  
  124. ENDPROC bestx,besty
  125.  
  126. /*=========================================================================*/
  127.  
  128. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  129.   DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  130.  
  131.   bell:=[50,49,47,40,25,13,10,8,6,5,4,3,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  132.   len:=ListLen(i)-1
  133.  
  134.   FOR x:=0 TO KSIZE-1
  135.     FOR y:=0 TO KSIZE-1
  136.       n:=kohonen_node(m,x,y)
  137.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  138.       IF d>0
  139.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  140.       ENDIF
  141.     ENDFOR
  142.   ENDFOR
  143. ENDPROC
  144.  
  145. /*=========================================================================*/
  146.  
  147. PROC kohonen_node(map:PTR TO LONG,x,y)
  148.   DEF r:PTR TO LONG
  149.   r:=map[x]
  150. ENDPROC r[y]
  151.  
  152. /*=========================================================================*/
  153.  
  154. PROC kohonen_init(numx,numy,numw)
  155. DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  156.   NEW m[numx]
  157.   FOR a:=0 TO numx-1
  158.     m[a]:=NEW r[numy]
  159.     FOR b:=0 TO numy-1
  160.       r[b]:=NEW w[numw]
  161.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  162.     ENDFOR
  163.   ENDFOR
  164. ENDPROC m
  165.  
  166.